home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 033a / sb_event.zip / SB_UPL.PRG < prev    next >
Text File  |  1990-07-29  |  6KB  |  218 lines

  1. *****************************************
  2. *
  3. * This file generates the top ten uploaders either
  4. * manualy or with the "SBEVENT" parameter.
  5. *
  6. * This will serve as an example as to the parameter passing.
  7. * Nothing fancy at all, it simply says if there is a PCOUNT() > 0  etc..
  8. * AND YOU KNOW THE REST.
  9. *
  10. * Feel free to use this code if you choose. It's only ASCI but it works.
  11. * It basicly is similar to the allfiles prg.
  12. * At the bottom of this file there is also a little batch run prg.
  13. * I havn't set the prg for the DOS command yet but will find the time
  14. * soon I hope.
  15. *!*********************************************************************
  16. *!
  17. *!      Procedure: UPGEN
  18. *!
  19. *!
  20. *!          Calls: SETNDX()       (function  in SBSUPP.PRG)
  21. *!               : OPEN_ERROR()   (function  in SB_ERR.PRG)
  22. *!               : STATBOX()      (function  in SBINIT.PRG)
  23. *!               : CLR()          (function  in ?)
  24. *!               : ADD_REC()      (function  in SBSUPP.PRG)
  25. *!               : REC_LOCKER()   (function  in SBSUPP.PRG)
  26. *!               : CHOP()         (function  in SBSUPP.PRG)
  27. *!               : CLOSEFILE()    (function  in SBSUPP.PRG)
  28. *!
  29. *!           Uses: MAINDIR.DBF    
  30. *!
  31. *!        Indexes: TEMP.NTX
  32. *!               : FILE("TEMP.NTX")
  33. *!
  34. *!    Other Files: &ASCFILE
  35. *!
  36. *!*********************************************************************
  37. PROCEDURE upgen
  38. PARAMETER upgen1
  39. PRIVATE num_param,event,u_name,s_name
  40. num_param = PCOUNT()
  41.  
  42. DO CASE
  43. CASE num_param = 0
  44.    event = .F.
  45. CASE num_param = 1
  46.    event = .T.
  47. ENDCASE
  48.  
  49. SELECT 4
  50. IF NET_USE(maindir,"BULLET",SHARED,10)
  51.    setndx(maindir,"BUL_X")
  52. ELSE
  53.    open_error("SBBULL",Procline(),"Unable to open " + maindir + "BULLET.DBF","","")
  54. ENDIF
  55.  
  56. ? CHR(7)
  57. IF event
  58.    statbox("Updating the TOP TEN UPLOADERS bulletin")
  59. ELSE
  60.    @ 23,0
  61.    clr(02,01,18,52)&&
  62.    SETCOLOR(gblink)
  63.    ? CHR(7)
  64.    @ 10,3 SAY "Creating and/or updating TOP TEN UPLOADERS bulletin"
  65. ENDIF
  66.  
  67. SETCOLOR(cyan)
  68.  
  69. SELECT bullet
  70. LOCATE FOR "TOP"$UPPER(DESC) .AND. "UP"$UPPER(DESC)
  71.  
  72. IF ! FOUND()
  73.    GOTO BOTTOM
  74.    Nextkey = KEY + 1
  75.    add_rec(0)
  76.    REPLACE KEY WITH Nextkey
  77.    UNLOCK
  78. ENDIF
  79.  
  80. rec_locker(0)
  81. REPLACE DESC WITH "Top 10 UP-LOADERS"
  82. REPLACE DATE WITH DATE()
  83. UNLOCK
  84. ascfile = TRIM(sbparms->sbulldir)+"SBB"+chop(KEY)+".ASC"
  85.  
  86. SELECT 1
  87. IF NET_USE(maindir,"USER",EXCLUSIVE,10)
  88.    INDEX ON 500 - no_of_up TO temp
  89.    setndx(maindir,"TEMP")
  90. ELSE
  91.    open_error("SBBULL",Procline(),"Unable to open " + maindir + "USER.DBF","","")
  92. ENDIF
  93.  
  94.  
  95. SET CONSOLE OFF
  96. ***************
  97. *
  98. * This is the ASCII FILE CREATION
  99. *
  100. ***************************************
  101. SET ALTERNATE TO &ascfile
  102. SET ALTERNATE ON
  103. ?? CHR(12)
  104. ?? " >>---> The TOP TEN <---<< A listing of the top uploaders as of "+;
  105.    DTOC(DATE())
  106. ? "╔" + REPLICATE("═",77) + "╗"
  107. Fcount = 1
  108.  
  109.  
  110. GOTO TOP
  111. DO WHILE Fcount <= 10
  112.    
  113.    u_name = UPPER(TRIM(first))+UPPER(TRIM(LAST))
  114.    s_name = UPPER(TRIM(sbparms->sysop_f))+UPPER(TRIM(sbparms->sysop_l))
  115.    
  116.    IF u_name = s_name
  117.       SKIP
  118.       LOOP
  119.    ENDIF
  120.    
  121.    top_up = TRIM(first)+" "+TRIM(LAST)
  122.    
  123.    ?  "║ " + top_up + SPACE(35-LEN(top_up))
  124.    ?? STR(no_of_up,6,0) + "       "
  125.    ?? city+" "+state+"          ║"
  126.    Fcount = Fcount + 1
  127.    IF Fcount < 11
  128.       ? "╟"+REPLICATE("─",77) + "╢"
  129.    ENDIF
  130.    SKIP
  131. ENDDO
  132.  
  133. ? "╚" + REPLICATE("═",77) + "╝"
  134. ? " "
  135. SET ALTERNATE OFF
  136. CLOSE ALTERNATE
  137. closefile("BULLET")
  138. closefile("USER")
  139.  
  140. SELECT 1
  141. IF NET_USE(maindir,"USER",SHARED,0)
  142.    setndx(maindir,"USER_N","USER_U")
  143. ELSE
  144.    open_error("SBBULL",Procline(),"Unable to open " + maindir + "USER.DBF","","")
  145. ENDIF
  146.  
  147. IF FILE("TEMP.NTX")
  148.    ERASE FILE("TEMP.NTX")
  149. ENDIF
  150.  
  151. IF event
  152.    SELECT sb_event
  153. ENDIF
  154.  
  155. INKEY(2)
  156. RETURN
  157.  
  158. ***************************************
  159. * This is my very crude and rude auto-backup
  160. * of everything thats important to me that is kept in
  161. * the main BBS directory. This program calls a DOS
  162. * batch file (which I have included ). Just to give you
  163. * a few ideas how I handle this evil thought of loosing 
  164. * everything in the directory (which has happened). 
  165. * The batch file calls a norton utility "FA" to reset the
  166. * file attributes, I know you can do this in the "F" commands
  167. * in Clipper but this was simpler for me. Anyway here it is
  168. * you will like it I am sure.
  169. *
  170. * Notice, in the batch file that I copy yesterdays backup to
  171. * another directory so you always have 2 copies on hand, much safer
  172. * and they are ZIPED so it's not a bunch of space. Of course ALL of the
  173. * dbf's were closed while doing this and then reopened in their
  174. * proper mode. All I do is call the INDEX PROC. and it takes care
  175. * of everything else.
  176. *
  177. *!*********************************************************************
  178. *!
  179. *!      Procedure: BAKITUP
  180. *!
  181. *!          Calls: CLOSEFILE()    (function  in SBSUPP.PRG)
  182. *!               : STATBOX()      (function  in SBINIT.PRG)
  183. *!               : OPEN_ERROR()   (function  in SB_ERR.PRG)
  184. *!
  185. *!           Uses: MAINDIR.DBF    
  186. *!
  187. *!*********************************************************************
  188. PROCEDURE bakitup
  189. *******************
  190. *
  191. * First I close everything "ALL DATAFILES" in case
  192. * it dumps. Thats not been a problem but better to
  193. * be safe.
  194. *
  195. *******************
  196. closefile("sbparms")
  197. closefile("user")
  198. ? CHR(7)
  199. statbox("Backing up all DATABASE,SCREEN,BATCH & LOG files")
  200. @ 0,0
  201.  
  202. ****************
  203. * Here is where I "RUN " the batch
  204. ****************
  205. RUN bbsbak.bat
  206.  
  207. SELECT 9
  208. IF ! NET_USE(maindir,"SBPARMS",SHARED,10)
  209.    open_error("SBINIT",Procline(),"Unable to open " + maindir + "SBPARMS.DBF","","")
  210.    CLOSE DATA
  211.    CLEAR
  212.    QUIT
  213. ENDIF
  214. GOTO NODE
  215.  
  216. RETURN
  217.